home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
pull5xa.arc
/
PULLSHEL.ARC
/
PULLSTAT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-01-10
|
12KB
|
344 lines
{ =========================================================================== }
{ PullStat.pas - User Statistics for pull-down menus. ver 5.X, 01-07-89 }
{ }
{ This file contains all the data for GetUserPullStats, GetOverrideStats and }
{ CheckGlobalKeys to configure the menus. }
{ Copyright (c) 1987-1989 James H. LeMay, All rights reserved. }
{ =========================================================================== }
{ R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ } { TP4 directives }
{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-} { TP5 directives }
{$define UseSubMenuCode }
{$define UseHelpWndwCode }
{$define UseDataEntryCode }
{$define UseMsgLineCode }
UNIT PullStat;
INTERFACE
uses
Crt,Qwik,Wutil,Wndw,Pull;
{ ------------------ Set up your window names here in order: ---------------- }
{ This is optional, but it sure helps you in not only understanding the
program, but also makes it unquestionably easier to rearrange. }
type
MainMenuNames = (NoMainMenu,FirstMenu,QuitMenu);
SubMenuNames = (NoSubMenu,MySubMenu);
{ These names are reserved up to HelpML and must match those in PULL.PAS. }
MsgLineNames = (NoML,WorkML,TopML,AltML,MainML,SubML,DW_ML,DE_ML,
SeqML,HelpML,ProcML);
HelpWndwNames = (NoHW,WorkWndwHW,TopLineHW,MainMenuHW,SubMenuHW,DataWndwHW);
HelpLineNames = (
NoHL, { HL - HelpLine; L - Last }
HLw1,HLwL, { Work window }
HLt1,HLtL, { Top Line menu }
HLm1,HLmL, { Main menu }
HLs1,HLsL, { Submenu }
HLd1,HLd2,HLd3,HLd4,HLd5,HLd6,HLdL); { Data window }
DataWndwNames = (NoDW,aByteDW);
{ Careful! - Always test your last main menu, submenu, data window, and help
window for run-time error! It makes sure you have allotted enough memory
with your constants. The compiler cannot check it with these typed scalars.}
procedure GetUserPullStats;
procedure GetOverrideStats;
procedure CheckGlobalKeys;
IMPLEMENTATION
{ -- Trivial utilities to get and save a menu record fro the heap -- }
procedure GetMainMenu (Name: MainMenuNames);
begin
MRI := ord (Name);
TopMenu := MainMenu^[MRI];
end;
procedure SaveMainMenu;
begin
MainMenu^[MRI] := TopMenu;
end;
{$ifdef UseSubMenuCode }
procedure GetSubMenu (Name: SubMenuNames);
begin
MRI := ord (Name);
TopMenu := SubMenu^ [MRI];
end;
procedure SaveSubMenu;
begin
SubMenu^[MRI] := TopMenu;
end;
{$endif }
{$ifdef UseHelpWndwCode }
procedure SetHelpLines (Name: HelpWndwNames; First,Last: HelpLineNames);
begin
HelpWndw[ord(Name)].FirstLine := ord(First);
HelpWndw[ord(Name)].LastLine := ord(Last);
end;
{$endif }
{ ============================ EXEC PROCEDURES ============================== }
{ Place procedures for execution by menu pointers, ProcPtr, here. }
{ They MUST be set to FAR calls. }
{ --------------------------------------------------------------------------- }
{$F+}
procedure DummyProc;
begin
{$ifdef UseMsgLineCode }
ShowMsg (ord(ProcML));
{$endif UseMsgLineCode }
Delay (1000)
end;
procedure SetQuit;
begin
PopToWorkWndw := true;
Quit := true;
end;
{$F-}
{ ======================== GetUserPullStats ================================= }
{ The major configurations for all menus go here. The program first clears }
{ all RECORD values to $00. The values below will set new values. Therefore, }
{ setting RECORD values to "false" or the like is not necessary. }
{ --------------------------------------------------------------------------- }
procedure GetUserPullStats;
begin
LocationWarning:=true; { If true and a Submenu won't fit, a message is
displayed. If false, you can override the
location without the message. }
{ ------------------ Set up your colors and borders here: ---------------- }
TopLineAttr := Black+LightGrayBG;
TopLineHattr := White+BlackBG;
MainMenuBattr := LightGray+BlackBG;
MainMenuHattr := Black+LightGrayBG;
MainMenuLattr := Yellow+BlackBG;
MainMenuCattr := LightGray+BlackBG;
Brdr[UserBrdr1].BrdrArray := '╒═╕││└─┘╞═╡╤│┴╪';
MainMenuBrdr := UserBrdr1;
{$ifdef UseSubMenuCode }
SubMenuWattr := Black+CyanBG;
SubMenuBattr := Black+CyanBG;
SubMenuBrdr := SingleBrdr;
{$endif UseSubMenuCode }
if VideoMode=7 then
begin
TopLineLattr := TopLineAttr;
MainMenuWattr:= LightGray+BlackBG;
{$ifdef UseSubMenuCode }
SubMenuHattr := Black +LightGrayBG;
SubMenuLattr := White +BlackBG;
SubMenuCattr := LightGray+BlackBG;
{$endif UseSubMenuCode }
end
else
begin
TopLineLattr := Red +LightGrayBG;
MainMenuWattr:= White+BlackBG;
{$ifdef UseSubMenuCode }
SubMenuHattr := White+BlueBG;
SubMenuLattr := White+CyanBG;
SubMenuCattr := Blue +CyanBG;
{$endif UseSubMenuCode }
end;
{$ifdef UseHelpWndwCode }
HelpWndwWattr := Black+GreenBG;
HelpWndwBattr := Black+LightGrayBG;
HelpWndwBrdr := HdoubleBrdr;
HelpWndwModes := ZoomMode+ShadowRight+CursorOffMode;
HelpBottomRow := CRTrows-4;
{$endif UseHelpWndwCode }
{$ifdef UseMsgLineCode }
MsgLineAttr := Green+BlackBG;
KeyStatusAttr := Black+GreenBG;
ErrMsgAttr := Yellow+RedBG;
MsgLineRow := CRTrows;
{$endif UseMsgLineCode }
{ ------------------------- Top Menu defaults ----------------------------- }
TopLineRow := 2; { Top line menu to appear on row 2 }
MPulled := ord(FirstMenu); { Main menu title to be HiLited by F10. }
MoreCmdSeq := 'F'; { Sequence of command letter(s) as if keyed in. This }
{ will be the default menu(s) pulled. }
PullDown := false; { Set this true if you want the command sequence}
{ to pull down the menus at startup. }
{ ------------------- Set up your MainMenu records here: ------------------ }
MainMenuRow := 3; { First row of Main menus to appear on screen row 3 }
with TopMenu do
begin
GetMainMenu (FirstMenu);
MenuMode := SingleChoice;
SingleFlagLine := 3;
Title := 'First';
Line[1] := 'A line';
Line[2] := 'B line';
Line[3] := 'C line';
Line[4] := 'D line';
DefaultLine := 2;
MsgLineNum := ord(MainML);
HelpWndwNum := ord(MainMenuHW);
SaveMainMenu;
GetMainMenu (QuitMenu);
{ MenuMode := ExecChoice; } { This is the default }
Title := 'Quit';
Line[1] := 'Stay';
Line[2] := 'Quit'; ProcPtr[2] := @SetQuit;
BackToDefault := true;
MsgLineNum := ord(MainML);
HelpWndwNum := ord(MainMenuHW);
SaveMainMenu;
{ ----------------------- Set up your SubMenus here: --------------------- }
{ Careful! -- indexes to SubMenus must be numbered in order of level; i.e.,}
{ ALL SubMenus first, ALL SubSubMenus second, ALL SubSubSubMenus, ... etc. }
{$ifdef UseSubMenuCode }
GetSubMenu (MySubMenu);
MenuMode := SingleChoice;
SingleFlagLine := 5;
Line[1] := '1 line';
Line[2] := '2 line';
Line[3] := '3 line';
Line[4] := '4 line';
MsgLineNum := ord(SubML);
HelpWndwNum := ord(SubMenuHW);
SaveSubMenu;
{$endif UseSubMenuCode }
end; { with TopMenu }
{ ------------------ Set up your Message Lines here: ---------------------- }
{ Concatenations here allow source to print on 80 col printer. }
{ All messages up to HelpML are reserved. }
{$ifdef UseMsgLineCode }
MsgLine[ord(WorkML)] :=' F1-help F2-pull F10-top';
MsgLine[ord(TopML)] :=' F1-help F2-pop LTR-cmd ESC-return '+
' '^[^Z' hilight CR-select';
MsgLine[ord(AltML)] :=' Alt: F-First '+
' X-Exit';
MsgLine[ord(MainML)]:=' F1-help F2-pop LTR-cmd ESC-return '+
' '^[^Z' menus '^X^Y'-hilight CR-select';
MsgLine[ord(SubML)] :=' F1-help F2-pop LTR-cmd ESC-return '+
' '^X^Y'-hilight CR-select';
MsgLine[ord(DW_ML)] :=' F1-help F2-pop F10-top ESC-restore '+
' CR-enter';
MsgLine[ord(DE_ML)] :=' F1-help F2-pull F10-top ESC-restore '+
' CR-enter';
MsgLine[ord(SeqML)] :=' F1-help F2-pull F10-top '+
' CR-edit';
MsgLine[ord(HelpML)]:=' F1-return LTR-cmd ESC-return';
MsgLine[ord(ProcML)] :=' Processing ...';
{$endif UseMsgLineCode }
{ ------------------- Set up your Help Lines here: ------------------------ }
{$ifdef UseHelpWndwCode }
HelpLine[ord(HLw1)]:='Work window help message';
HelpLine[ord(HLwL)]:='';
HelpLine[ord(HLt1)]:='Move cursor and press return OR type a command';
HelpLine[ord(HLtL)]:='letter. ESC to return to the Work window.';
HelpLine[ord(HLm1)]:='Main menu help message';
HelpLine[ord(HLmL)]:='';
HelpLine[ord(HLs1)]:='Submenu help message';
HelpLine[ord(HLsL)]:='';
HelpLine[ord(HLd1)]:='This is a data entry field. Only valid alpha-';
HelpLine[ord(HLd2)]:='numeric characters can be typed. Full editing';
HelpLine[ord(HLd3)]:='capability:';
HelpLine[ord(HLd4)]:=' 1. WordStar keys: ^A,^S,^D,^F,^G,^H,^R,^Y,^U';
HelpLine[ord(HLd5)]:=' 2. Cursor keys: Home/End, Left/Right Arrow,';
HelpLine[ord(HLd6)]:=' Ctrl-Left/Right Arrow, and Ins/Del.';
HelpLine[ord(HLdL)]:=' 3. Use ^R or ^U to restore original data.';
{ ----------------------- Set up your Help Windows here: ------------------ }
{ HelpWndw[ord(WorkWndwHW)] is reserved for the Work window. }
{ HelpWndw[ord(TopLineHW) ] is reserved for the top line menu. }
HelpMsgLineNum := ord(HelpML); { Standard message for a Help window }
SetHelpLines (WorkWndwHW,HLw1,HLwL);
SetHelpLines (TopLineHW ,HLt1,HLtL);
SetHelpLines (MainMenuHW,HLm1,HLmL);
SetHelpLines (SubMenuHW ,HLs1,HLsL);
SetHelpLines (DataWndwHW,HLd1,HLdL);
{$endif UseHelpWndwCode }
end; { procedure GetUserPullStats }
{ =========================== GetOverrideStats ============================== }
{ You can OVERRIDE the automatic Colors, Sizes, and Locations here. }
{ --------------------------------------------------------------------------- }
procedure GetOverrideStats;
begin
{ No overrides included. }
end;
{ ========================= CHECK GLOBAL KEYS =============================== }
{ This procedure gives you the option to add global keys similar to TP4 such }
{ as Alt-R or Alt-F3. This is for extended keys only. }
{ --------------------------------------------------------------------------- }
const
{ See the extended key code table in your manual for these values: }
AltF = #33; { First menu }
AltQ = #16; { Quit menu }
AltX = #45; { Immediately exit program }
procedure SetWorkWndw (WN: WindowNames);
begin
PullDown := false;
PopToWorkWndw := true;
TopWorkWndwName := WN;
end;
{ -- Any of the keys can be modified. PopKey and TopKey1 are defined in }
{ -- PullVars.inc. }
procedure CheckGlobalKeys;
begin
PullDown := true;
case Key of
PopKey: begin PullDown:=false; PopToWorkWndw:=true; end; { F2 }
TopKey1: PopToTop:=true; { F10 }
AltF: SetCmdSeq ('F');
AltQ: SetCmdSeq ('Q');
AltX: SetQuit;
else
PullDown := false;
end
end;
BEGIN
AddrGetUserPullStats := @GetUserPullStats;
AddrGetOverrideStats := @GetOverrideStats;
AddrCheckGlobalKeys := @CheckGlobalKeys;
END.